VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "clsRASEngine"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'*---------------------------------------------------------------
'*
'* ClassName:      clsRASEngine
'* FileName:       RASENGINE.CLS
'* Date:           July 1998
'* Author:         Ian M. Weatherburn
'* Company:        Mindkey Software Solutions (Pty) Ltd.
'* Copyright:      Copyright (C) 1998 by Mindkey Software Solutions
'*                 All Rights Reserved
'* Description:    Remote Access Server Configuration
'*
'*---------------------------------------------------------------

Option Explicit

Private lpOSInfo As OSVersionInfo
Private sngOSVersion As Single
Private hRASDLLInstance As Long

Private Sub Class_initialize()
  ' We need version information for all RAS functions
  Dim lngErrNum As Long
  Dim lngBugFix As Long
  
  ' Initialize classes to avoid potential problems
  ' as documented in Q143261
  
  ' Initialise RAS Error handling
  Set lpRASError = New clsRASError
  lngBugFix = lpRASError.ErrorNumber
  
  ' Initialise RAS Phone entries
  Set lpPhoneEntries = New clsPhoneEntries
  lngBugFix = lpPhoneEntries.Count
  
  ' Initialise RAS Connections
  Set lpConnections = New clsConnections
  lngBugFix = lpConnections.Count
  
  ' Initialise RAS Server
  lngErrNum = fnLoadAndCheckRAS()
  If lngErrNum Then
    Err.Raise vbObjectError + 1911, _
              "RAS.RASEngine", _
              "RAS could not be initialised. WIN32 Error: " & Str$(lngErrNum)
  Else
    ' We now have RAS on the system and it is now running
    lpOSInfo.dwOSVersionInfoSize = 148
    If (GetVersionEx(lpOSInfo)) Then
      ' Set the global version variable for use in all other RAS functions.
      ' This is declared in the basGlobal Module
      lngWindowVersion = lpOSInfo.dwPlatformId
      sngOSVersion = CSng(lpOSInfo.dwMajorVersion) + _
                     CSng(Val("." & Str$(lpOSInfo.dwMinorVersion)))
    Else
      lngErrNum = GetLastError()
      Err.Raise vbObjectError + 1912, _
                "RAS.RASEngine", _
                "GetVersionEx Failed with WIN32 Error: " & Str$(lngErrNum)
    End If
  End If
  
End Sub

Private Sub Class_Terminate()
  Dim lngErrorNum As Long
  Dim intLoop As Long
  
  ' Discarding errors because this is in case the user is
  ' being careless with superfluous connections.
  ' Remove this code if you want connections to remain
  ' open after the server is terminated.
  On Error Resume Next
  
  ' Release connections
  For intLoop = 0 To lpConnections.Count - 1
    lpConnections.RemoveConnection (intLoop)
  Next intLoop
  On Error GoTo 0
  
  ' Decrement the function instance handle
  ' as documented in Q143261
  
  ' Release RAS Phone Entries
  Set lpPhoneEntries = Nothing
  
  ' Release RAS Connections
  Set lpConnections = Nothing
  
  ' Release RAS Error Handler
  Set lpRASError = Nothing
  
  lngErrorNum = fnUnloadRAS()
  
  If lngErrorNum Then
    Err.Raise vbObjectError + 1913, _
              "RAS.RASEngine", _
              "RAS was not properly unitialised. WIN32 Error: " & Str$(lngErrorNum)
  End If
End Sub

Public Property Get OSVersion() As Single
  OSVersion = sngOSVersion
End Property

Public Property Get OSBuildNumber() As Long
  OSBuildNumber = lpOSInfo.dwBuildNumber
End Property

Public Property Get OSType() As Long
  ' VER_PLATFORM_WIN32s = 0&
  ' VER_PLATFORM_WIN32_WINDOWS = 1&
  ' VER_PLATFORM_WIN32_NT = 2&
  OSType = lpOSInfo.dwPlatformId
End Property

Public Function RASError() As clsRASError
  Set RASError = lpRASError
End Function

Public Function Connections(Optional ByVal Index As Variant) As Object
  If IsMissing(Index) Then
    ' Set pointer to my PhoneEntries collection object
    Set Connections = lpConnections
  Else
    ' Set pointer to the PhoneEntry object
    Set Connections = arrConnection(Index)
  End If
End Function

Public Function PhoneEntries(Optional ByVal Index As Variant) As Object
  If IsMissing(Index) Then
    ' Set pointer to my PhoneEntries collection object
    Set PhoneEntries = lpPhoneEntries
  Else
    ' Set pointer to the PhoneEntry object
    Set PhoneEntries = arrPEntry(Index)
  End If
End Function


Private Function fnLoadAndCheckRAS()
  ' Determine RAS availability and load DLL's
  ' so startup later is faster.
  hRASDLLInstance = LoadLibrary("RASAPI32.DLL")
  If hRASDLLInstance Then
    fnLoadAndCheckRAS = 0
  Else
    fnLoadAndCheckRAS = GetLastError()
  End If
End Function

Private Function fnUnloadRAS() As Long
  Dim lngRetCode As Long
  
  ' Decrement the instance count of RASAPI32.DLL
  ' caused by the LoadLibrary at startup.
  lngRetCode = FreeLibrary(hRASDLLInstance)
  
  If lngRetCode Then
    fnUnloadRAS = 0
  Else
    fnUnloadRAS = GetLastError()
  End If
End Function

'*---------------------------------------------------------------
'* EOF: clsRASEngine
'*---------------------------------------------------------------

